home *** CD-ROM | disk | FTP | other *** search
/ Aminet 52 / Aminet 52 (2002)(GTI - Schatztruhe)[!][Dec 2002].iso / Aminet / misc / emu / Apex-src.lha / COPY.XPL < prev    next >
Text File  |  2001-09-30  |  15KB  |  674 lines
  1. \COPY.XPL    JUL-07-88
  2. \COPY UTILITY FOR APEX VERSION 1.8-68K
  3.  
  4. \REVISION HISTORY:
  5. \NOV-85, Added verify when replacing older file with a newer one, added date,
  6. \ added one disk copy, and rearranged miscellaneous stuff, L.B.
  7. \MAR-12-86, Modified for 32-bit XPL on the Stride, L.B.
  8. \JUN-13-86, Allow lowercase characters, L.B.
  9. \OCT-13-86, Modify for new system page
  10. \DEC-08-86, Changed CONWID (it's no longer on SYSPAG)
  11. \APR-10-87, Changed BLIT and string conventions.
  12. \JUL-07-88, Added protection aginst copying to a non-Apex disk, use FREE
  13. \ intrinsic.
  14.  
  15. code    REM=2,        RESERVE=3,    SWAP=4,        REBEGIN=6,
  16.     CHIN=7,        CHOUT=8,    CRLF=9,        INTIN=10,
  17.     INTOUT=11,    TEXT=12,    OPENI=13,    FREE=18,
  18.     WRITE=30,    READ=31,    BLIT=36;
  19.  
  20. \THE DIRECTORY:
  21. addr    FNAME,        \THE NAME AND EXTENSION FOR EACH FILE
  22.     FSTAT,        \THE STATUS FOR EACH FILE
  23.     STAB,        \SORT TABLE, ORDER IN ASCENDING "FBLK"S
  24.     NUMVAL,        \LAST ELEMENT OF "STAB" ARRAY (MAXSTB)
  25.     DIRCHG,        \"$A5" INDICATES DIRECTORY NEEDS TO BE SORTED
  26.     PRDEV,        \DEFAULT DEVICE NUMBER
  27.     DFNAME,        \THE DEFAULT FILE NAME AND EXTENTION
  28.     TITLE,        \TITLE OF THE VOLUME
  29.     UNUSED,        \UNUSED SPACE
  30.     APEXID,        \A 4-BYTE VALUE USED TO RECOGNIZE AN APEX DISK
  31.     FLAGS;        \I.E: PACK, BACKUP, CHECK, UNLOCKED, SEARCH, ABORT
  32. \16-BIT INTEGER ARRAYS IN THE DIRECTORY:
  33. int    FBLK,        \THE FIRST BLOCK OF EACH FILE
  34.     LBLK,        \THE LAST BLOCK
  35.     FEMBLK,        \EMPTY BLOCKS FILE LIST (FIRST BLOCK)
  36.     LEMBLK,        \ (LAST BLOCK) SORTED LARGEST SIZE FIRST
  37.     PMAXB,        \MAXIMUM BLOCK NUMBER (= UNIT SIZE -1)
  38.     VOLUME,        \UNIQUE VOLUME (DIRECTORY) ID NUMBER
  39.     DIRDAT,        \DIRECTORY DATE (SYSTEM DATE)
  40.     FDATE;        \DATE FOR EACH FILE
  41.  
  42. \DEFINE SOME OFFSETS INTO SYSTEM PAGE
  43.  
  44. \THE SYSTEM GLOBALS:
  45. addr    PARM,        \SYSTEM PAGE PARAMETERS
  46.     MOSTR,        \ARRAY OF MONTH NAMES (STRING)
  47.     LOCNAM;        \LOCAL NAME OF FILE
  48.  
  49. int    CONWID,        \WIDTH OF CONSOLE (CHARACTERS)
  50.     BLKSIZ,        \SIZE OF A BLOCK IN BYTES
  51.     DIRSIZ,        \DIR SIZE
  52.     DIRBLK,        \WHERE DIRECT IS
  53.     USERBLK,    \FIRST USER BLOCK
  54.     BACKBLK,    \BLOCK TO PU BACKUP DIR IN
  55.     FIRBLK,        \FIRST BLOCK OF FILE
  56.     LASBLK,        \LAST BLOCK OF FILE
  57.     FLNO,        \NUMBER OF FILE
  58.     MAXBLK,        \HIGHEST BLOCK
  59.     MAXFL,        \HIGHEST FILE NO
  60.     CHAR,        \INPUT CHARACTER
  61.     SYSDAT,        \SYSTEM DATE
  62.     INDATE,        \DATE OF LAST INFILE
  63.     MAXSTB;        \SIZE OF STAB ARRAY
  64.  
  65. int    DIRLEN;        \ARRAY: LENGTHS (IN WORDS) OF SEGMENTS OF THE DIRECTORY
  66. def    MAXSEG=10;    \THE LAST SEGMENT (ELEMENT) IN "DIRLEN"
  67. def    EXTPAT=$A5;    \FLAG PATTERN INDICATING EXTENDED DIR IS USED
  68.  
  69. \FOR MAIN:
  70. int    FILE,TOBLK,FRBLK,SIZE,BUFSIZ,RDSIZ,II,L,
  71.     DRIVE,FRDRV,TODRV,NEXFL,MAXDRV;
  72. addr    BUFFER,MYNAME;
  73.  
  74. \CONSTANTS:
  75.  
  76. \FILE STATUS IN THE DIRECTORY:
  77. def    NULL=0,TENTATIVE=255,REPLACE=254,VALID=1;
  78.  
  79. \FAILED FLAG
  80. def    NONE=$FFFF;
  81.  
  82. def    SP=$20;
  83.  
  84. \----------------------------------------------------------------------\
  85.  
  86. proc    PUT16(ARRAY, INDEX, VALUE);
  87. \STORE A 16-BIT VALUE INTO THE DIRECTORY ARRAY ENTRY AT "INDEX"
  88. \NOTE THE BYTE ORDER IS LOW BYTE, HIGH BYTE
  89. addr    ARRAY;
  90. int    INDEX, VALUE;
  91. begin
  92. INDEX:= INDEX + INDEX;            \DOUBLE FOR WORD ENTRIES
  93. ARRAY(INDEX):= VALUE;            \STORE LOW BYTE
  94. ARRAY(INDEX+1):= SWAP(VALUE);        \STORE HIGH BYTE
  95. end;    \PUT16
  96.  
  97.  
  98.  
  99. func    GET16(ARRAY, INDEX);
  100. \RETURN A 16-BIT VALUE FROM THE DIRECTORY ARRAY ENTRY AT "INDEX"
  101. \NOTE THE BYTE ORDER IS LOW BYTE, HIGH BYTE
  102. addr    ARRAY;
  103. int    INDEX;
  104. begin
  105. INDEX:= INDEX + INDEX;            \DOUBLE FOR WORD ENTRIES
  106. return ARRAY(INDEX) + SWAP(ARRAY(INDEX+1));
  107. end;    \GET16
  108.  
  109. \----------------------------------------------------------------------\
  110.  
  111. proc    NEXT;
  112. begin
  113. CHAR:= CHIN(0);
  114. if CHAR>=^a & CHAR<=^z then CHAR:=CHAR -32;    \CONVERT TO UPPERCASE
  115. end;    \NEXT
  116.  
  117.  
  118.  
  119. proc    CR;
  120. CRLF(0);
  121.  
  122.  
  123.  
  124. proc    TXT(STR);
  125. addr    STR;
  126. TEXT(0,STR);
  127.  
  128.  
  129.  
  130. proc    NUMOUT(I);
  131. int    I;
  132. INTOUT(0,I);
  133.  
  134.  
  135.  
  136. func    ALPHANUM;    \CHECK FOR ALPHANUMERIC OR "?"
  137. return ((CHAR>=^0)&(CHAR<=^9))!((CHAR>=^A)&(CHAR<=^Z))!(CHAR=^?);
  138.  
  139. \----------------------------------------------------------------------\
  140.  
  141. func    VERIFY;        \RETURN 'TRUE' IF "Y" (OR "y") IS TYPED IN
  142. begin
  143. TXT(" - ARE YOU SURE (N/Y)? ");
  144. OPENI(0);
  145. return (CHIN(0)!$20)= ^y;
  146. end;    \VERIFY
  147.  
  148.  
  149.  
  150. proc    NEWDISK(FLAG);    \PROMPT USER TO INSERT DISK
  151. int    FLAG;
  152. begin
  153. if TODRV=FRDRV then
  154.     begin
  155.     TEXT(0,if FLAG then "INSERT COPY DISK"
  156.     else "RESTORE ORIGINAL DISK");
  157.     while not VERIFY do;
  158.     end;
  159. end;    \NEWDISK
  160.  
  161.  
  162.  
  163. proc    PRDATE(DATE);    \OUTPUT THE DATE, E.G: NOV-07-85
  164. int    DATE;
  165. int    DAY,MO,I;
  166.  
  167.  
  168.     proc    NUM2(N);
  169.     int    N;
  170.     begin
  171.     if N<10 then CHOUT(0,^0);
  172.     NUMOUT(N);
  173.     end;    \NUM2
  174.  
  175.  
  176. begin
  177. if DATE<=0 then [TXT("NO DATE  ");   return];
  178. DATE:= DATE/32;
  179. DAY:= REM(0);
  180. DATE:= DATE/16;
  181. MO:= REM(0);
  182.  
  183. MO:= (MO-1)*3;
  184. for I:= 0,2 do CHOUT(0,MOSTR(MO+I));
  185. CHOUT(0,^-);
  186. NUM2(DAY);
  187. CHOUT(0,^-);
  188. NUM2(DATE+76);
  189. end;    \PRDATE
  190.  
  191. \----------------------------------------------------------------------\
  192.  
  193. proc    NAME(DEFAULT);
  194. \GET A FILE NAME FROM THE OPERATOR AND PUT IT INTO "LOCNAM".
  195. \ SET TO DEFAULT EXTENSION IF NONE WAS GIVEN. EXPAND *'S INTO FIELDS OF ?'S.
  196. \OUTPUTS:    LOCNAM        FILE NAME AND EXTENSION
  197. \        LOCDEV        DEVICE (UNIT) NUMBER
  198. addr    DEFAULT;        \DEFAULT EXTENSION
  199. int    K;
  200. begin
  201. if CHAR#13\CR\ then NEXT;
  202. while CHAR=SP do NEXT;
  203. K:= 0;
  204. while ALPHANUM do
  205.     begin
  206.     LOCNAM(K):= CHAR;
  207.     if K<8 then K:= K+1;
  208.     NEXT;
  209.     end;
  210. if CHAR=^* then        \FILL OUT THE REST OF THE NAME WITH "?"
  211.     [for K:= K,7 do LOCNAM(K):= ^?;
  212.     NEXT]
  213. else    for K:= K,7 do LOCNAM(K):= SP;
  214.  
  215. if CHAR=^. then
  216.     begin
  217.     NEXT;
  218.     K:= 8;
  219.     while ALPHANUM do
  220.         begin
  221.         LOCNAM(K):= CHAR;
  222.         if K<11 then K:= K+1;
  223.         NEXT;
  224.         end;
  225.     if CHAR=^* then
  226.         [for K:= K,10 do LOCNAM(K):= ^?;
  227.         NEXT]
  228.     else for K:= K,10 do LOCNAM(K):= SP;
  229.     end
  230. else    begin
  231.     LOCNAM(8):= DEFAULT(0);
  232.     LOCNAM(9):= DEFAULT(1);
  233.     LOCNAM(10):= DEFAULT(2);
  234.     end;
  235. end;    \NAME
  236.  
  237.  
  238.  
  239. proc    ERROR(STR);    \YOU BLEW IT BABES!
  240. addr    STR;
  241. begin
  242. CR;
  243. CHOUT(0,$07);        \BEL
  244. TXT("NOPE - ");   TXT(STR);   CR;
  245. NEWDISK(false);        \RESTORE ORIGINAL DISK
  246. CR;
  247. \PARM(EXECUT):= $FF;    \\ABORT ANY COMMAND FILE
  248. \PARM(LINIDX):= $FF;
  249. REBEGIN;
  250. end;    \ERROR
  251.  
  252. \----------------------------------------------------------------------\
  253.  
  254. proc    MOVIT(AB1,AB2,LEN);    \MOVE "LEN" WORDS INTO B1 FROM B2
  255. int    AB1,AB2,LEN,LEN2;    \B1 & B2 ARE LEFT POINTING TO THE LAST POSITION
  256. int    B1, B2, I;
  257. begin
  258. B1:= AB1(0);
  259. B2:= AB2(0);
  260. LEN2:= LEN+LEN;
  261. BLIT(B2, B1, LEN2);
  262. AB1(0):= B1 + LEN2;
  263. AB2(0):= B2 + LEN2;
  264. end;    \MOVIT
  265.  
  266.  
  267.  
  268. proc    GETDIR(DEV, BAKDIR);    \READ IN THE DIRECTORY
  269. int    DEV, BAKDIR;
  270. int    I, EXTDIR, BASE1, BASE2, BASE3;
  271. begin
  272. EXTDIR:= RESERVE(1024);
  273.  
  274. \READ THE EXTENDED DIR INTO "EXTDIR"
  275. READ(DEV, if BAKDIR then 5 else 1, EXTDIR, DIRSIZ);
  276.  
  277. \READ PRIMARY DIRECTORY INTO THE BIG DIRECTORY SPACE
  278. READ(DEV, if BAKDIR then 13 else 9, FNAME, DIRSIZ);
  279.  
  280. \MERGE THE EXTENDED DIRECTORY INTO THE PRIMARY DIRECTORY
  281. BASE1:= FNAME+528;    \(FSTAT)
  282. BASE2:= EXTDIR+528;
  283. BASE3:= FSTAT;
  284. for I:= 0,MAXSEG do
  285.     begin
  286.     MOVIT(addr BASE3, addr BASE1, DIRLEN(I));
  287.     MOVIT(addr BASE3, addr BASE2, DIRLEN(I));
  288.     end;
  289. BLIT(EXTDIR, FNAME+528, 528);
  290.  
  291. MAXFL:= if FLAGS(7)=EXTPAT then 95 else 47;
  292. end;    \GETDIR
  293.  
  294.  
  295.  
  296.  
  297. proc    PUTDIR(DEV, BAKDIR);    \WRITE THE DIRECTORY
  298. int    DEV, BAKDIR;
  299. int    I, EXTDIR, BASE1, BASE2, BASE3;
  300. begin
  301. EXTDIR:= RESERVE(1024);
  302.  
  303. \SEPARATE THE BIG DIR INTO THE PRIMARY DIR AND THE EXTENDED DIR
  304. BLIT(FNAME+528, EXTDIR, 528);
  305. BASE1:= FNAME+528;
  306. BASE2:= EXTDIR+528;
  307. BASE3:= FSTAT;
  308. for I:= 0,MAXSEG do
  309.     begin
  310.     MOVIT(addr BASE1, addr BASE3, DIRLEN(I));
  311.     MOVIT(addr BASE2, addr BASE3, DIRLEN(I));
  312.     end;
  313.  
  314. \IF EXTENDED DIR IS USED THEN WRITE "EXTDIR" INTO THE EXTENDED DIR
  315. if FLAGS(7)=EXTPAT then
  316.     WRITE(DEV, if BAKDIR then 5 else 1, EXTDIR, DIRSIZ);
  317.  
  318. \WRITE THE PRIMARY DIR
  319. WRITE(DEV, if BAKDIR then 13 else 9, FNAME, DIRSIZ);
  320.  
  321. \NOW FIX THE BIG DIR
  322. BLIT(EXTDIR, FNAME+528, 528);
  323. end;    \PUTDIR
  324.  
  325.  
  326.  
  327. proc    WRTDIR;
  328. int    BITS;
  329. begin
  330. BITS:= [$01,$02,$04,$08,$10,$20,$40,$80];
  331. \PARM(UNTUPD):= PARM(UNTUPD)!BITS(DRIVE);
  332. DIRCHG(0):= $A5;
  333. APEXID(0):= ^a;
  334. APEXID(1):= ^p;
  335. APEXID(2):= ^e;
  336. APEXID(3):= ^x;
  337. PUTDIR(DRIVE,false);
  338. end;    \WRTDIR
  339.  
  340. \----------------------------------------------------------------------\
  341.  
  342. func    LOOKUP(FILE);
  343. \LOOKUP THE FILENAME IN LOCFILE BEGINNING AT DIRECTORY ENTRY NUMBER "FILE".
  344. \TAKE "?" AS WILD. RETURN THE FILE NUMBER.
  345. int    FILE;
  346. int    L;
  347. begin
  348. loop    begin
  349.     if FSTAT(FILE)=VALID then
  350.         begin
  351.         L:= 0;
  352.         loop    begin
  353.             if (LOCNAM(L)#^?) & (FNAME(FILE*11+L)#LOCNAM(L))
  354.             then quit;
  355.             L:= L+1;
  356.             if L=11 then quit;
  357.             end;
  358.         if L=11 then quit;    \WE HAVE IT
  359.         end;
  360.     FILE:= FILE+1;
  361.     if FILE>MAXFL then quit;
  362.     end;
  363. return if FILE<=MAXFL then FILE else NONE;
  364. end;    \LOOKUP
  365.  
  366.  
  367.  
  368. proc    PRINT(FILE);
  369. int    FILE,MIN,MAX,K,SIZE;
  370. begin
  371. NUMOUT(DRIVE);
  372. CHOUT(0,^:);
  373. for K:= 0,7 do CHOUT(0,FNAME(FILE*11+K));
  374. CHOUT(0,^.);
  375. for K:= 8,10 do CHOUT(0,FNAME(FILE*11+K));
  376. MIN:= GET16(FBLK,FILE);
  377. MAX:= GET16(LBLK,FILE);
  378. SIZE:= MAX-MIN+1;
  379. TXT("  ");   NUMOUT(SIZE);
  380. if SIZE<10 then CHOUT(0,SP);
  381. if SIZE<100 then CHOUT(0,SP);
  382. if SIZE<1000 then CHOUT(0,SP);
  383. TXT("  ");
  384. if CONWID>60 then [PRDATE(GET16(FDATE,FILE));   TXT("  ")];
  385. NUMOUT(MIN);   CHOUT(0,^-);   NUMOUT(MAX);
  386. end;    \PRINT
  387.  
  388. \----------------------------------------------------------------------\
  389.  
  390. proc    RDDIR;
  391. begin
  392. GETDIR(DRIVE,false);
  393. MAXBLK:= GET16(PMAXB,0);
  394. end;    \RDDIR
  395.  
  396.  
  397.  
  398. proc    GETNAM(FILE);
  399. int    FILE,I;
  400. for I:= 0,10 do LOCNAM(I):= FNAME(FILE*11+I);
  401.  
  402.  
  403.  
  404. func    EMSIZ(I);
  405. int    I;
  406. begin
  407. FIRBLK:= if I<0 then USERBLK else GET16(LBLK,STAB(I)) +1;
  408. LASBLK:= if (MAXSTB<0)!(MAXSTB=I) then MAXBLK
  409. else GET16(FBLK, STAB(I+1)) - 1;
  410. return if LASBLK>=FIRBLK then LASBLK-FIRBLK+1 else 0;
  411. end;    \EMSIZ
  412.  
  413. \----------------------------------------------------------------------\
  414.  
  415. proc    SORT;        \BUBBLE SORT THE FILES INTO ASCENDING FBLK
  416. int    I,J,T;
  417. begin
  418. J:= 0;
  419. for I:= 0,MAXFL do
  420.     if FSTAT(I)=VALID then
  421.         [STAB(J):= I;   J:= J+1];
  422. MAXSTB:= J-1;
  423. for I:= 0,MAXSTB-1 do
  424. if GET16(FBLK, STAB(I+1)) < GET16(FBLK, STAB(I)) then
  425.     \WE ARE OUT OF ORDER SO...
  426.     begin
  427.     J:= I;
  428.     repeat begin
  429.         T:= STAB(J);
  430.         STAB(J):= STAB(J+1);
  431.         STAB(J+1):= T;
  432.         J:= J-1;
  433.         end
  434.     until GET16(FBLK, STAB(J)) < GET16(FBLK, STAB(J+1)) ! J<0;
  435.     end;
  436. end;    \SORT
  437.  
  438.  
  439.  
  440. proc    FIND(SIZE);    \FIND FIXED SIZE SPACE, SET FIRST AND LAST BLOCK TO IT
  441. int    SIZE,I;
  442. begin
  443. if SIZE<=0 then ERROR("BAD FILE");
  444. SORT;
  445. I:= -1;
  446. while EMSIZ(I)<SIZE & I<=MAXSTB do I:= I+1;
  447. if I>MAXSTB then ERROR("NOT ENOUGH SPACE");
  448. LASBLK:= FIRBLK+SIZE-1;
  449. end;    \FIND
  450.  
  451. \----------------------------------------------------------------------\
  452.  
  453. proc    ENTER;    \ENTER A TENTATIVE FILE AND ITS BLOCKS INTO THE DIRECTORY
  454. int    K;    \DON'T RESERVE THE BLOCKS, DON'T MARK IT VALID
  455. begin
  456. for K:= 0,10 do
  457.     if LOCNAM(K)=^? then ERROR("BAD FILE");
  458. \FIND AN EMPTY DIR SLOT
  459. FLNO:= 0;
  460. while FSTAT(FLNO)=VALID do
  461.     begin
  462.     FLNO:= FLNO+1;
  463.     if FLNO>MAXFL then ERROR("DIRECTORY IS FULL");
  464.     end;
  465. \NOW COPY THE NAME INTO IT
  466. for K:= 0,10 do FNAME(FLNO*11+K):= LOCNAM(K);
  467. PUT16(FBLK, FLNO, FIRBLK);
  468. PUT16(LBLK,FLNO,LASBLK);
  469. FSTAT(FLNO):= REPLACE;
  470. PUT16(FDATE,FLNO,INDATE);
  471. end;    \ENTER
  472.  
  473.  
  474.  
  475. proc    CLOMARK(FILE);
  476. int    FILE;
  477. begin
  478. FSTAT(FILE):= VALID;
  479. FIRBLK:= GET16(FBLK,FILE);
  480. LASBLK:= GET16(LBLK,FILE);
  481. TXT("CLOSING:  ");   PRINT(FILE);
  482. CR;
  483. end;    \CLOMARK
  484.  
  485. \----------------------------------------------------------------------\
  486.  
  487. proc    CLOFIL(FILE);
  488. int    FILE,S,FILENO;
  489.  
  490.  
  491.     proc    CLEAR(FILE);
  492.     int    FILE;
  493.     begin
  494.     \REMOVE A ENTRY FROM THE DIRECTORY, FREE UP ITS BLOCKS
  495.     if FSTAT(FILE)#VALID then return;
  496.     FSTAT(FILE):= NULL;
  497.     TXT("REMOVING: ");   PRINT(FILE);
  498.     CR;
  499.     end;    \CLEAR
  500.  
  501.  
  502. begin    \CLOFIL
  503. \CLOSE THE TENTATIVE FILE BY DIRECTORY NUMBER
  504. \ASSUME IT HAS BEEN ENTERED
  505. \REMOVE COLLISIONS
  506. S:= FSTAT(FILE);
  507. if (S#TENTATIVE)&(S#REPLACE) then ERROR("INTERNAL ERROR");
  508. GETNAM(FILE);
  509.  
  510. \REMOVE ANY COLLISIONS WITH LOCFILE
  511. \NEW FILE = "FILE" (OR LOCFILE OR FLNO),  EXISTING FILE = "FILENO"
  512. FILENO:= LOOKUP(0);
  513. if FILENO=NONE then CLOMARK(FILE)
  514. else    begin
  515.     if INDATE<GET16(FDATE,FILENO) then
  516.         begin
  517.         TXT("ABOUT TO REPLACE NEWER FILE");
  518.         if VERIFY then
  519.             begin
  520.             CLEAR(FILENO);        \GO AHEAD AND DO IT
  521.             CLOMARK(FILE);
  522.             end
  523.         else    FSTAT(FILE):= NULL;    \REMOVE TENATIVE FILE
  524.         end
  525.     else    begin
  526.         CLEAR(FILENO);
  527.         CLOMARK(FILE);
  528.         end;
  529.     end;
  530. end;    \CLOFIL
  531.  
  532. \----------------------------------------------------------------------\
  533.  
  534. proc    READBUF;
  535. begin
  536. RDSIZ:= if SIZE>BUFSIZ then BUFSIZ else SIZE;
  537. READ(DRIVE,FRBLK,BUFFER,RDSIZ);
  538. end;    \READBUF
  539.  
  540.  
  541.  
  542. proc    WRTBUF;
  543. begin
  544. WRITE(DRIVE,TOBLK,BUFFER,RDSIZ);
  545. FRBLK:= FRBLK+RDSIZ;
  546. TOBLK:= TOBLK+RDSIZ;
  547. SIZE:= SIZE-RDSIZ;
  548. end;    \WRTBUF
  549.  
  550. \----------------------------------------------------------------------\
  551.  
  552. begin    \MAIN
  553. MOSTR:= "JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC";
  554. DIRLEN:= [24, 48, 48, 6, 6, 24, 8, 16, 16, 48, 4];
  555.  
  556. PARM:= $0400;                \LOCATION OF RESIDENT SYSTEM PAGE
  557. CONWID:= 80;                \GET CONSOLE WIDTH
  558.  
  559. BLKSIZ:= 256;                \SIZE OF A BLOCK IN BYTES
  560. DIRBLK:= 9;                \LOCATION OF DIRECTORY BLOCK
  561. DIRSIZ:= 4;                \SIZE OF DIRECTORY IN "BLKSIZ" BLOCKS
  562. BACKBLK:= DIRBLK + DIRSIZ;        \LOCATION OF BACKUP DIRECTORY
  563. USERBLK:= BACKBLK + DIRSIZ;        \START OF USER FILE SPACE
  564.  
  565. MAXFL:= 95;                \SELECT SO THAT DIRSIZ IS RIGHT
  566.  
  567.                     \RESERVE THE ARRAYS
  568. II:= (MAXFL+1)*2;
  569.                     \BLOCKS 0-2
  570. FNAME:= RESERVE(8*BLKSIZ);                    \%%%
  571. FSTAT:= FNAME + ((MAXFL+1)*11);
  572. FBLK:= FSTAT + (MAXFL+1);
  573. LBLK:= FBLK + (II);
  574.                     \BLOCK 3
  575. FEMBLK:= LBLK + (II);
  576. LEMBLK:= FEMBLK + (24);
  577. STAB:= LEMBLK + (24);
  578. NUMVAL:= STAB + (MAXFL+1);
  579. DIRCHG:= NUMVAL + (1);
  580. PRDEV:= DIRCHG + (1);
  581. PMAXB:= PRDEV + (1);
  582. DFNAME:= PMAXB + (2);
  583. UNUSED:= DFNAME + (11);
  584. TITLE:= UNUSED + (16);
  585. UNUSED:= TITLE + (64);
  586. APEXID:= UNUSED + (24);
  587. VOLUME:= APEXID + (4);
  588. DIRDAT:= VOLUME + (2);
  589. UNUSED:= DIRDAT + (2);
  590. FDATE:= UNUSED + (32);
  591. FLAGS:= FDATE + (II);
  592. \FLAGS + (16);
  593.  
  594. \NON DIR ARRAYS
  595. LOCNAM:= RESERVE(11);
  596. MYNAME:= RESERVE(11);
  597. MAXDRV:= 7;
  598.  
  599. TXT("-- COPY, V1.8x5 --
  600. ");
  601. BUFSIZ:= FREE/256 -5;
  602. BUFFER:= RESERVE(BUFSIZ*256);
  603.  
  604. loop    begin
  605.     NEXFL:= 0;
  606.     TXT("FILE? ");
  607.     CHAR:= 0;
  608.     NAME("@@@");
  609.     if LOCNAM(0)=SP then quit;
  610.     for II:= 0,10 do MYNAME(II):= LOCNAM(II);
  611.  
  612.     TXT("FROM, TO UNITS? ");
  613.     \OPENI(0);
  614.     FRDRV:= INTIN(0);
  615.     TODRV:= INTIN(0);
  616.     CR;
  617.     if FRDRV<0 ! FRDRV>MAXDRV ! TODRV<0 ! TODRV>MAXDRV then
  618.         ERROR("BAD UNIT NUMBER");
  619.  
  620.     loop    begin        \OVER ALL FILES THAT MATCH
  621.         DRIVE:= FRDRV;
  622.         RDDIR;
  623.         for II:= 0,10 do LOCNAM(II):= MYNAME(II);
  624.         FILE:= LOOKUP(NEXFL);
  625.         if FILE=NONE then
  626.             begin
  627.             if NEXFL=0 then ERROR("NO SUCH FILE");
  628.             quit;
  629.             end;
  630.         NEXFL:= FILE+1;
  631.         for II:= 0,10 do LOCNAM(II):= FNAME(FILE*11+II);
  632.         TXT("MOVING:   ");   PRINT(FILE);   CR;
  633.         FRBLK:= GET16(FBLK,FILE);        \ITS FIRST BLOCK
  634.         SIZE:= GET16(LBLK,FILE) - FRBLK + 1;    \ITS SIZE
  635.         INDATE:= GET16(FDATE,FILE);        \ITS DATE
  636.         READBUF;
  637.  
  638.         NEWDISK(true);        \INSERT COPY DISK IF NEEDED
  639.         DRIVE:= TODRV;
  640.         RDDIR;
  641.         if APEXID(0)#^a ! APEXID(1)#^p ! APEXID(2)#^e ! APEXID(3)#^x then
  642.             begin
  643.             ERROR("NOT AN APEX DIRECTORY");
  644.             quit;        \DON'T COPY ONTO A NON-APEX DISK OR
  645.             end;        \ ONTO AN INCORRECTLY SUBBED DISK
  646.         FIND(SIZE);
  647.         ENTER;
  648.         TOBLK:= FIRBLK;
  649.         WRTBUF;
  650.         while SIZE>0 do
  651.             begin
  652.             NEWDISK(false);    \RESTORE DISK IF NECESSARY
  653.             DRIVE:= FRDRV;
  654.             READBUF;
  655.             NEWDISK(true);    \INSERT COPY DISK IF NEEDED
  656.             DRIVE:= TODRV;
  657.             WRTBUF;
  658.             end;
  659.         CLOFIL(FLNO);
  660.         WRTDIR;        
  661.         NEWDISK(false);        \RESTORE DISK IF NECESSARY
  662.         CR;
  663.         end;
  664.     OPENI(0);
  665.     end;
  666. end;    \MAIN
  667. d;
  668.         CLOFIL(FLNO);
  669.         WRTDIR;        
  670.         NEWDISK(false);        \RESTORE DISK IF NECESSARY
  671.         CR;
  672.         end;
  673.     OPENI(0);
  674.     end;